home *** CD-ROM | disk | FTP | other *** search
- {$A+,B-,D-,E-,F-,G+,I+,L-,N-,O-,R-,S-,V+,X-}
-
- { Módulo de la copia de disquetes }
- { (c) Emilio David Diaus 1994 }
-
- {
- Mcopy - NΘCleo De La Copia De Disquetes.
- A TravéS De Mcopy Se Realiza El Copiado De Disquetes Propiamente Dicho, Mcopy Es Una
- Unidad Que Entra En Funcionamiento Por Medio Del Procedimiento Copy_Disk Llamado Por Mprog
- En Handleevent.
- En Mcopy Se Crea Un Nuevo Objeto De DiáLogo Dependiente De Tdialog Que Se Encargará
- De Copiar Los Disquetes. A Copy Disk Se Le Pasan Tres ParáMetros Obtenidos Previamente En
- Mprog: NúMero De La Unidad De Disquete A Procesar, NúMero De Copias Que Se Van A Hacer y
- Si Se Van A Verificar Las Copias O No.
- Para Usar Un DiáLogo Como Sistema Para Copiar Disquetes He Tenido Que Modificar El
- MéTodo Execute Para Adaptarlo A Mis Necesidades. El MéTodo Execute Consta De Un Bucle
- Donde Se Procesan Los Diversos Sucesos, En Mi MéTodo Execute Hay Dos Bucles Que Coinciden
- Con La Lectura Y Con La Escritura Del Disquete Y De Los Que Se Sale Por Medio De Handlevent Que
- Procesa El Suceso Si Hemos Pulsado Esc O Hemos Activado AlgúN Comando De Cerrar La Ventana
- Mediante El RatóN O Alt-F3, AdemáS Se Encarga De Analizar El Disquete Introducido Desechando
- Los Disquetes ErróNeos, Actualiza El Sistema De Ayuda Para Poder Ser Utilizado Con La GestióN De
- Errores ,Contabilizar El Progreso De La Copia Y El Tiempo De La Misma.
- Para Saber Donde Se Va A Colocar La Imagen Del Disquete Existe El Tipo Tplace Y La Variable
- Where Y Su Funcionamiento Es El Siguiente: Primero Se Comprueba Si Hay Memoria Extendida,
- Si La Hay Se Utiliza Esta Y A La Variable Where Se Le Asigna El Valor In_Xms, Si No Hay Suficiente
- Memoria Extendida Se Prueba Con La Memoria Expandida Y Si Hay Suficiente Se Asigna A Where
- El Valor In_Ems, Por úLtimo Si No Hay Suficiente Memoria Extendida Ni Expandida Se Utiliza El
- Disco Duro Y La Imagen Se Coloca En El Mismo Directorio Donde Se Ejecuta El Programa En El
- Fichero Disk.Dat Que Al Finalizar El Programa Se Borra.
- Utiliza El Programa Mas Memoria De La Que Se Necesita Como Un Sistema De Seguridad,
- Para Eso Está La Variable Mempool Que Aloja 16 Kb MáS De Memoria.
- La Copia De Disquetes Se Puede Interrumpir En Cualquier Momento Por Medio De La Tecla
- De Esc O Pulsando Con El RatóN En El Icono De Cerrar Del DiáLogo Situado En La Esquina Superior
- Izquierda Del Mismo.
- Los MóDulos Que Utiliza El Programa Son Los Siguientes:
- Dos,Crt,Emimsbox,Objects,Drivers,Views,Dialogs,Emiapp,Mdhelp - Para La GestióN De La
- PresentacióN Y De Los DiáLogos Y Objetos Visuales Y Las Definiciones De Ayuda Y Sucesos
- Del Programa.
- Mdrive - MóDulo Que Da Soporte A Las Funciones Bios De Manejo De Disquetes.
- Timer - MóDulo Para Contar El Tiempo.
- Mxmsst - MóDulo Para La CreacióN De Un Flujo O Tstream Que Utiliza Memoria Extendida.
- Ahora Voy A Describir Los Procedimientos MáS Importantes De Copydlg, Puesto Que Los
- Procedimientos Derivados EstáNdar Han Sido Explicados Con Anterioridad No Los Trataré Ahora:
- Procedure Draw - Dibuja El DiáLogo Que Es El áRea De Trabajo Del Programa.
- Procedure Read_Floppy - Lee El Disquete Fuente.
- Procedure Write_Floppy - Escribe Mediante Un Bucle Los Disquetes De Destino.
- Procedure Get_Real_Time - Obtiene El Tiempo Real De Copia.
- Procedure Get_Estimated_Time(Track:Byte) - Obtiene El Tiempo Estimado De Copia.
- Procedure Updating - Actualiza Algunos Datos Del DiáLogo.
- Function Execute:Word - EfectúA El Copiado De Los Disquetes.
- Function Interrupcion:Boolean -Comprueba Si El Usuario Quiere De Verdad Salir Del
- Programa O Ha Pulsado Esc Equivocadamente.
- AdemáS De Estos Procedimientos Tenemos Las Siguientes Variables:
- La Ya Mencionada Where, AdemáS De Mempool Reserva De Memoria De Seguridad De
- 16Kb Por Si Acaso, Estas Son Las Mas Importantes, Hay Otras De Menor Importancia.
- El Programa Detecta Los Errores De Disquete E Interrumpe La Copia Si Es Necesario.
- El Programa Ha Sido Realizado De Modo Que Sea En Execute Donde Se Realice Realmente
- La Copia Del Disquete, En Otros Casos Se Emplea Un Bucle Para La GestióN De Los Sucesos,
- Pero Como Aquí Execute Tiene Dos Partes, La Parte De Lectura Del Disquete Y La Parte De
- Escritura, Por Eso Hay Dos Bucles Que Captan Las Teclas Pulsadas Por El Usuario. Para Salir
- Del Programa O Bien Se Pulsa Esc O Con El RatóN Encima Del Icono De Cerrar Ventana
- Situado En La Parte Superior Izquierda De Esta.
- Mediante De La UtilizacióN De Un Conmutador /V El Programa Verifica Que La Copia Se Ha
- Realizado Correctamente.
- }
- Unit Mcopy;
- Interface
- Uses Dos,Crt,Objects,Views,Dialogs,Emiapp,Mdrive,Drivers,Mdhelp;
- Const Cmempool=1024*16; { Salvaguardia de memoria }
- Fpverify = $001; { FpXXXX= Banderas del programa }
- Fptofile = $002;
- Fpfromfile = $004;
-
- Type Tplace=(Nowhere,In_Hard_Disk,In_Xms,In_Ems); { Tipo ¿Donde copiamos? }
-
- Type Pcopydlg=^Copydlg;
- Copydlg=Object(Tdialog) { Díalogo de copia }
-
- Disk : Tdrive; { Objeto que maneja el disquete }
- Where : Tplace; { ¿Donde copiamos? }
- Bo_Exit_Dlg : Boolean; { ¿Salir? }
- Wnumber_Of_Tracks,
- Wflags : Word; { Banderas de acciones }
- Lglobal_Time, { El tiempo }
- Bdrive_Number : Byte;
- Ltotal_Copies,
- Lcopies_Done : Longint; { Las copias }
- Apar : Array[0..2] Of Longint;
- { Para visualizar parámetros }
- Fout : Pstream;
- { Flujo donde colocar la imagen del disquete }
- Ev : Tevent; { Sucesos }
- Sfile_Name : String;
- { Fichero donde puede ir la imagen del disquete }
-
- Constructor Init(Var Vcbounds: Trect; Vctitle: Ttitlestr;Vcbdrive: Byte;Vcicopies:Integer;
- Vcwflags:Word;Vcsfile:String);
-
- Procedure Read_Floppy;
- Procedure Write_Floppy;
-
- Procedure Get_Real_Time;
- Procedure Get_Estimated_Time(Btrack:Byte);
-
- Function Interrupcion:Boolean;
-
- Procedure Draw;Virtual;
- Procedure Updating;
- Function Execute:Word;Virtual;
-
- Procedure Handleevent(Var Event:Tevent);Virtual;
-
- Destructor Done;Virtual;
-
- End;
-
- Procedure Copy_Disk(Vpbdrive:Byte;Vpicopies:Integer;Vpwflags:Word;Vpsfile:String);
-
- Implementation
- Uses Emimsbox,Timer,Mxmsst;
-
- Procedure Play(Vpwhz,Vpwdly:Word);
- Begin
- Sound(Vpwhz);
- Delay(Vpwdly);
- Nosound;
- End;
-
-
- Procedure Copy_Disk(Vpbdrive:Byte;Vpicopies:Integer;Vpwflags:Word;Vpsfile:String);
- Var Wresult : Word;
- R : Trect;
- Dlg : Pcopydlg;
- Begin
- Play(1000,750);
- If Vpwflags And Fpfromfile=0 Then Begin
- Wresult:=Messagebox(' Introduzca disquete FUENTE ',Nil,Mfconfirmation+Mfokbutton);
- If Wresult In [Cmclose,Cmcancel] Then Exit;
- End;
- Desktop^.Getextent(R);
- Inc(R.A.Y);
- Dlg:=New(Pcopydlg,Init(R,'Ventana de trabajo',Vpbdrive,Vpicopies,Vpwflags,Vpsfile));
- Wresult:=Desktop^.Execview(Dlg);
- Dispose(Dlg,Done);
- End;
-
- Constructor Copydlg.Init(Var Vcbounds: Trect; Vctitle: Ttitlestr;Vcbdrive: Byte;Vcicopies:Integer;
- Vcwflags:Word;Vcsfile:String);
- Var Sline:String;
- Begin
- Tdialog.Init(Vcbounds,Vctitle);
- Bdrive_Number:=Vcbdrive;
- Ltotal_Copies:=Vcicopies;
- Wflags:=Vcwflags;
- Helpctx:=Hccpant;
- Sline:=Getenv('TEMP');
- If Sline='' Then
- Getdir(0,Sline);
- If Sline[Length(Sline)]<>'\' Then Sline:=Sline+'\';
- If Vcsfile='' Then
- Sfile_Name:=Sline+'disk.dat'
- Else
- Sfile_Name:=Sline+Vcsfile;
- End;
-
- Procedure Copydlg.Read_Floppy;
-
- Var Lhow_Much,
- Ltrack_Size,
- Lhow_Many,
- Lerr_In_Track_Number : Longint;
- Bposition,
- Bloop : Byte;
- Sline,Sauxline : String;
- Wresult : Word;
-
- Begin
- Updating;
- Inittimer(2);
- Where:=In_Xms;
- With Disk Do Begin
- Lhow_Much:=(Longint(Disk.Sectores_Totales)*
- Longint(Disk.Bytes_Por_Sector)+Cmempool);
- Ltrack_Size:=Sectores_Por_Pista*Bytes_Por_Sector;
- End;
- If (Wflags And Fptofile=Fptofile) Or
- (Wflags And Fpfromfile=Fpfromfile) Then
- Writestr(5,17,' Fichero temporal '+Sfile_Name+' ',6);
- Fout:=New(Pxmsstream,Init(Lhow_Much));
- Bposition:=4;
- Sline:=#253;
- If (@Fout=Nil) Or (Fout^.Status<>Stok) Then Begin
- Fout:=New(Pemsstream,Init(Lhow_Much,Lhow_Much));
- Bposition:=5;Sline:=#252;
- Where:=In_Ems;
- End;
- If Fout^.Status<>Stok Then Begin
- Fout := New(Pdosstream, Init(Sfile_Name,Stcreate));
- Where:=In_Hard_Disk;
- Bposition:=6;Sline:=#251;
- End;
- Lhow_Many:=Lhow_Much Div 1024;
- Formatstr(Sauxline,'%04d',Lhow_Many);
- Writestr(63,Bposition,Sauxline,11);
- Wnumber_Of_Tracks:=Pred(Disk.Pistas);
- Inittimer(1);
- For Bloop:=0 To Wnumber_Of_Tracks Do Begin
- Disk.Numero_Error:=Disk.Leepista(0,Bloop);
- If (Disk.Numero_Error>0) Then Begin
- Application^.Helpctx:=Hcdlectura;
- Lerr_In_Track_Number:=Bloop;
- Play(600,750);
- Wresult:=Messagebox(' Error de lectura en pista %02d,'#13' copia abortada',
- @Lerr_In_Track_Number,Mferror+Mfokbutton);
- Bo_Exit_Dlg:=True;Exit;
- End;
- Fout^.Write(Disk.Pista,Ltrack_Size);
- If Eventavail Then Begin
- Getevent(Ev);
- Handleevent(Ev);
- End;
- If (Bo_Exit_Dlg) And (Interrupcion) Then Exit;
- If Bloop<=39 Then
- Writechar(6,7,Sline[1],Ord(Where)*3+2,Bloop+1)
- Else Begin
- Writechar(6,7,Sline[1],Ord(Where)*3+2,40);
- Writechar(6,10,Sline[1],Ord(Where)*3+2,Bloop+1-40);
- End;
- Disk.Numero_Error:=Disk.Leepista(1,Bloop);
- If (Disk.Numero_Error>0) Then Begin
- Application^.Helpctx:=Hcdlectura;
- Lerr_In_Track_Number:=Bloop;
- Play(700,750);
- Wresult:=Messagebox(' Error de lectura en pista %02d,'#13' copia abortada',
- @Lerr_In_Track_Number,Mferror+Mfokbutton);
- Bo_Exit_Dlg:=True;Exit;
- End;
- Fout^.Write(Disk.Pista,Ltrack_Size);
- Get_Real_Time;
- Get_Estimated_Time(Bloop);
- End;
- If (Fout<>Nil) And (Where=In_Hard_Disk) Then
- Dispose(Fout,Done);
- End;
-
- Procedure Copydlg.Write_Floppy;
- Var Bposition,
- Bloop,
- Btimes : Byte;
- Ltrack_Size : Integer;
- Sline : String;
- Lerr_In_Track_Number,
- Lhow_Much : Longint;
- Wresult : Word;
- Fout2 : Pstream;
-
- Begin
- Disk.Numero_Error:=Disk.Verificapista(0,0);
- Updating;
- Inittimer(2);
- Ltrack_Size:=Disk.Sectores_Por_Pista*Disk.Bytes_Por_Sector;
- If Wflags And Fpfromfile=Fpfromfile Then Begin
- Where:=In_Hard_Disk;
- End;
- Case Where Of
- In_Xms:Begin
- Bposition:=4;Sline:=#253;
- End;
- In_Ems:Begin
- Bposition:=5;Sline:=#252;
- End;
- In_Hard_Disk: Begin
- Fout := New(Pdosstream, Init(Sfile_Name,Stopenread));
- If (Wflags And Fpfromfile=Fpfromfile) Then Begin
- Lhow_Much:=Longint(Disk.Sectores_Totales)*Longint(Disk.Bytes_Por_Sector) Div 1024;
- Formatstr(Sline,'%04d',Lhow_Much);
- Bposition:=6;
- Writestr(63,Bposition,Sline,11);
- Sline:=#251;
- End;
- End;
- End;
- If (Wflags And Fptofile=Fptofile) Or
- (Wflags And Fpfromfile=Fpfromfile) Then
- Writestr(5,17,' Fichero temporal '+Sfile_Name+' ',6);
- Inittimer(1);
- Fout^.Seek(0);
- For Bloop:=0 To Wnumber_Of_Tracks Do Begin
- Fout^.Read(Disk.Pista,Ltrack_Size);
- Disk.Numero_Error:=Disk.Grabapista(0,Bloop);
- If Eventavail Then Begin
- Getevent(Ev);
- Handleevent(Ev);
- End;
- If (Bo_Exit_Dlg) And (Interrupcion) Then Exit;
- Btimes:=1;
- While (Disk.Numero_Error<>0) And (Btimes<3) Do Begin
- Disk.Numero_Error:=Disk.Format(0,Bloop);
- If Bloop<=39 Then
- Writechar(6+Bloop,7,'O',11,1)
- Else
- Writechar(6+Bloop-40,10,'O',11,1);
- Disk.Numero_Error:=Disk.Grabapista(0,Bloop);
- Inc(Btimes);
- End;
- If Wflags And Fpverify=Fpverify Then
- Disk.Numero_Error:=Disk.Verificapista(0,Bloop);
- If (Disk.Numero_Error>0) And (Btimes>=3) Then Begin
- Lerr_In_Track_Number:=Bloop;
- Play(700,750);
- Wresult:=Messagebox(' Error de escritura en pista %02d,'#13' copia abortada',
- @Lerr_In_Track_Number,Mferror+Mfokbutton);
- Bo_Exit_Dlg:=True;Exit;
- End;
- Fout^.Read(Disk.Pista,Ltrack_Size);
- If Bloop<=39 Then
- Writechar(6,7,Sline[1],Ord(Where)*2-1,Bloop+1)
- Else Begin
- Writechar(6,7,Sline[1],Ord(Where)*2-1,40);
- Writechar(6,10,Sline[1],Ord(Where)*2-1,Bloop+1-40);
- End;
- Disk.Numero_Error:=Disk.Grabapista(1,Bloop);
- If Eventavail Then Begin
- Getevent(Ev);
- Handleevent(Ev);
- End;
- If (Bo_Exit_Dlg) And (Interrupcion) Then Exit;
- Btimes:=1;
- While (Disk.Numero_Error<>0) And (Btimes<3) Do Begin
- Disk.Numero_Error:=Disk.Format(1,Bloop);
- If Bloop<=39 Then
- Writechar(6+Bloop,7,'O',11,1)
- Else
- Writechar(6+Bloop-40,10,'O',11,1);
- Disk.Numero_Error:=Disk.Grabapista(1,Bloop);
- Inc(Btimes);
- End;
- If Wflags And Fpverify=Fpverify Then
- Disk.Numero_Error:=Disk.Verificapista(0,Bloop);
- If (Disk.Numero_Error>0) And (Btimes>=3) Then Begin
- Lerr_In_Track_Number:=Bloop;
- Play(700,750);
- Wresult:=Messagebox(' Error de escritura en pista %02d,'#13'copia abortada',
- @Lerr_In_Track_Number,Mferror+Mfokbutton);
- Bo_Exit_Dlg:=True;Exit;
- End;
- Get_Real_Time;
- Get_Estimated_Time(Bloop);
- End;
- If (Fout<>Nil) And (Where=In_Hard_Disk) Then Dispose(Fout,Done);
- If Not(Where=In_Hard_Disk) And (Wflags And Fptofile=Fptofile) Then Begin
- Writestr(5,17,' Creando fichero temporal '+Sfile_Name+' ... ',1);
- Fout2:=New(Pdosstream,Init(Sfile_Name,Stcreate));
- Fout^.Seek(0);
- Lhow_Much:=Longint(Disk.Sectores_Totales)*Longint(Disk.Bytes_Por_Sector);
- Fout2^.Copyfrom(Fout^,Lhow_Much);
- Dispose(Fout2,Done);
- End;
- End;
-
- Procedure Copydlg.Get_Real_Time;
- Var Wh,Wm,Ws,Wcs : Word;
- Sline : String;
-
- Begin
- Get_Timer_Vars(2,Wh,Wm,Ws,Wcs);
- Apar[0]:=Wm;
- Apar[1]:=Ws;
- Apar[2]:=Wcs;
- Formatstr(Sline,'%02d:%02d.%02d',Apar);
- Writestr(7,15,Sline,26);
- End;
-
- Procedure Copydlg.Get_Estimated_Time(Btrack:Byte);
- Var Wh,Wm,Ws,Wcs : Word;
- Ltime : Longint;
- Bdisks_Per_Hour : Byte;
- Sline : String;
- Begin
- Get_Timer_Vars(1,Wh,Wm,Ws,Wcs);
- Ltime:=(Rtimer[1] Div (Btrack+1))*80;
- If Ltime=Lglobal_Time Then Exit;
- Bdisks_Per_Hour:=3600 Div (Ltime Div 100);
- Wh:=Word(Ltime Div 360000);
- Ltime:=Word(Ltime Mod 360000);
- Wm:=Word(Ltime Div 6000);
- Ltime:=Word(Ltime Mod 6000);
- Ws:=Word(Ltime Div 100);
- Ltime:=Word(Ltime Mod 100);
- Wcs:=Ltime;
- Apar[0]:=Wm;
- Apar[1]:=Ws;
- Apar[2]:=Wcs;
- Formatstr(Sline,'%02d:%02d.%02d',Apar);
- Writestr(18,15,Sline,26);
- Apar[0]:=Bdisks_Per_Hour;
- Formatstr(Sline,' %03d ',Apar);
- Writestr(35,15,Sline,26);
- Lglobal_Time:=Ltime;
- End;
-
- Function Copydlg.Interrupcion:Boolean;
- Var Wresult : Word;
- Begin
- Interrupcion:=False;
- Play(1200,750);
- Wresult:=Messagebox(' Seleccione CANCELAR para continuar la copia o SI para salir del programa.',
- Nil,Mfyesbutton+Mfcancelbutton+Mfconfirmation);
- If Not (Wresult In [Cmclose,Cmcancel]) Then
- Interrupcion:=True
- Else
- Bo_Exit_Dlg:=False;
- End;
-
- Procedure Copydlg.Draw;
-
- Type Eframe=String[8];
-
- Const
- Cdoubleframe : Eframe = #201#205#187#186#186#200#205#188;
- Csingleframe : Eframe = #218#196#191#179#179#192#196#217;
-
- Var Bloop:Byte;
-
-
- Procedure Writerect(Vpiix,Vpiiy,Vpifx,Vpify:Integer;Frame:Eframe;Bcolor:Byte);
- Var Bloop:Byte;
- Begin
- Writechar(Vpiix,Vpiiy,Frame[1],Bcolor,1);
- Writechar(Vpiix+1,Vpiiy,Frame[2],Bcolor,Vpifx-Vpiix-1);
- Writechar(Vpifx,Vpiiy,Frame[3],Bcolor,1);
- Writechar(Vpiix,Vpify,Frame[6],Bcolor,1);
- Writechar(Vpiix+1,Vpify,Frame[7],Bcolor,Vpifx-Vpiix-1);
- Writechar(Vpifx,Vpify,Frame[8],Bcolor,1);
- For Bloop:=Vpiiy+1 To Vpify-1 Do Begin
- Writechar(Vpiix,Bloop,Frame[4],Bcolor,1);
- Writechar(Vpiix+1,Bloop,#32,Bcolor,Vpifx-Vpiix-1);
- Writechar(Vpifx,Bloop,Frame[4],Bcolor,1);
- End;
- End;
-
- Begin
- Tdialog.Draw;
- Writerect(3,18,76,20,Csingleframe,19);
- Writestr(4,19,' '#253'= Mem. extendida '#252'= Mem. expandida '#251'= Disco duro O= Formateando',19);
- Writerect(3,2,76,17,' ',19);
- Writerect(4,3,47,12,Csingleframe,21);
- Writestr(6,3,' Esquema de pistas utilizadas ',21);
- For Bloop:=0 To 39 Do Begin
- If Bloop Mod 10=0 Then Begin
- Writechar(6+Bloop,5,Chr(Ord('0')+(Bloop Div 10)),19,1);
- Writechar(6+Bloop,8,Chr(Ord('0')+((Bloop+40) Div 10)),19,1);
- End;
- Writechar(6+Bloop,6,Chr(Ord('0')+(Bloop Mod 10)),19,1);
- Writechar(6+Bloop,9,Chr(Ord('0')+((Bloop+40) Mod 10)),19,1);
- End;
- Writerect(48,3,74,7,Csingleframe,11);
- Writestr(49,3,' Uso de la memoria ',11);
- Writestr(50,4,'Extendida XXXX Kb.',11);
- Writestr(50,5,'Expandida XXXX Kb.',11);
- Writestr(50,6,'Disco duro XXXX Kb.',11);
- Writerect(48,8,74,16,Csingleframe,2);
- Writestr(49,8,' Información del disco ',2);
- Writestr(53,10,'Copias XXX',2);
- Writestr(53,11,'Copia actual XXX',2);
- Writestr(53,12,'Quedan XXX',2);
- Writestr(54,14,'Tipo de unidad',2);
- Updating;
- Writerect(4,13,47,16,Csingleframe,25);
- Writestr(6,13,' Tiempo de copia ',25);
- Writestr(6,14,' Real Estimado',25);
- Writestr(6,15,' XX:XX.XX XX:XX.XX ',26);
- Writestr(30,14,' Disquetes/hora ',25);
- Writestr(35,15,'<XXX>',26);
- Writechar(6,7,#32,1,40);
- Writechar(6,10,#32,1,40);
- End;
-
- Procedure Copydlg.Updating;
- Var Lsize:Longint;
- Sline:String;
- Begin
- Case Disk.Tipo_Unidad Of
- K360: Writestr(50,15,' 5'#172' 360Kb ',5);
- K1200: Writestr(50,15,' 5'#172' 1200Kb ',5);
- K720: Writestr(50,15,' 3'#171' 720Kb ',5);
- K1440: Writestr(50,15,' 3'#171' 1440Kb ',5);
- End;
- Lsize:=(Longint(Disk.Sectores_Totales)*
- Longint(Disk.Bytes_Por_Sector)) Div 1024;
- Formatstr(Sline,' %4dKb',Lsize);
- Writestr(63,15,Sline,2);
- Lsize:=Ltotal_Copies;
- Formatstr(Sline,'%03d',Lsize);
- Writestr(66,10,Sline,2);
- Lsize:=Lcopies_Done;
- Formatstr(Sline,'%03d',Lsize);
- Writestr(66,11,Sline,2);
- Lsize:=Ltotal_Copies-Lcopies_Done;
- Formatstr(Sline,'%03d',Lsize);
- Writestr(66,12,Sline,2);
- End;
-
- Function Copydlg.Execute:Word;
- Var Wresult,
- Whlpcontext : Word;
- Icopiando : Integer;
- Sline : String;
-
-
- Begin
- Whlpcontext:=Application^.Gethelpctx;
- With Disk Do Begin
- Init(Bdrive_Number);
- If Numero_Error>0 Then Begin
- Case Numero_Error Of
- Cerrbytessecinc,Cerrsecporclinc,
- Cerrsecporpinc,Cerrnumheadinc: Begin
- Application^.Helpctx:=Hcarranqueincorr;
- Sline:='Información del sector de arranque incorrecta.';
- End;
- Cerrdescrmedinc:Begin
- Application^.Helpctx:=Hcmedioinc;
- Sline:='Descriptor de tipo de medio no válido.';
- End;
- Cerrunidileg:Begin
- Application^.Helpctx:=Hcdilegible;
- Sline:='Unidad ilegible.';
- End;
- Cerrunidadvacia: Begin
- Application^.Helpctx:=Hcdilegible;
- Sline:='No ha introducido un disquete en la unidad.';
- End;
- Else Begin
- Application^.Helpctx:=Hcdilegible;
- Sline:='Error indefinido de acceso'#13' a la unidad.';
- End;
- End;
- Play(900,750);
- Wresult:=Messagebox(Sline,Nil,Mferror+Mfokbutton);
- Disk.Done;
- Exit;
- End;
- Application^.Helpctx:=Hcdincorrec;
- Numero_Error:=Definemedio(Pred(Pistas),Sectores_Por_Pista);
- If Numero_Error>0 Then Begin
- Play(800,750);
- Wresult:=Messagebox(' Error al definir el tipo de medio para el formato. ',Nil,Mferror+Mfokbutton);
- Disk.Done;
- Exit;
- End;
- End;
- Bo_Exit_Dlg:=False;
- If Wflags And Fpfromfile=0 Then Read_Floppy;
- Writechar(6,7,#32,1,40);
- Writechar(6,10,#32,1,40);
- If Bo_Exit_Dlg=False Then
- For Icopiando:=1 To Integer(Ltotal_Copies) Do Begin
- Lcopies_Done:=Icopiando;
- Play(700,750);
- Wresult:=Messagebox(' Introduzca disquete DESTINO'+#13+
- ' número %03d en '+Chr(Bdrive_Number+65)+':',@Lcopies_Done,Mfconfirmation+Mfokbutton);
- Application^.Helpctx:=Whlpcontext;
- If Wresult In [Cmclose,Cmcancel] Then Exit;
- If Bo_Exit_Dlg=False Then Write_Floppy;
- End;
- Application^.Helpctx:=Whlpcontext;
- Disk.Done;
- If Valid(Ev.Command) Then Endmodal(Ev.Command);
- End;
-
- Procedure Copydlg.Handleevent(Var Event:Tevent);
- Begin
- If (Event.Command In [Cmclose,Cmcancel]) Then Begin
- Bo_Exit_Dlg:=True;
- Clearevent(Event);
- End;
- If (Event.What=Evkeydown) And
- (Event.Charcode=#27) Then Begin
- Bo_Exit_Dlg:=True;
- Clearevent(Event);
- End;
- Tdialog.Handleevent(Event);
- End;
-
- Destructor Copydlg.Done;
- Var F:File;
- Begin
- {$I-}
- If (Fout<>Nil) And (Wflags And Fpfromfile=0) Then Dispose(Fout,Done);
- If (Where=In_Hard_Disk) And (Wflags And Fptofile=0) Then Begin
- Assign(F,Sfile_Name);
- Erase(F);
- End;
- Tview.Done;
- End;
-
- End.
-